home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / r2dbf121.zip / CONV501.PRG < prev    next >
Text File  |  1992-05-31  |  13KB  |  319 lines
  1. /*
  2.     CONVERT.PRG
  3.     Author:   Eric J. Givler
  4.     Language: Clipper 5.01, IDL v2.0 LIBRARY (BIT_AND, BIT_NOT, BIT_OR)
  5.     Date:     02-22-91
  6.     Mods:     01-08-92 (CVS.PRG, REAL2IEE.PRG)
  7.     Mods:     05-30-92 (Rewrite for Clipper 5.01 and IDL Library)
  8.  
  9.     Previous version:
  10.     Link:   CV_READ (Basic number reading by John Wright (in CV_READ.LIB)
  11.             DECIMAL.C and SETBIT (C routines to do bit setting etc.)
  12.             2BYTEDAT.C (converts the 2 Byte subscription date)
  13.             MBF2NUM.C (converts the Microsoft Binary Format Numbers)
  14. */
  15.  
  16. #include "fileio.ch"
  17. #include "user.ch"
  18.  
  19. FUNCTION Convert( UserFile )
  20. LOCAL handle, length         // file handle, length of file
  21. LOCAL recs, n                // records, pointer
  22. LOCAL User_[U_LENGTH]        // the user data broken down
  23. LOCAL UserBuffer             // Buffer to hold complete record
  24. LOCAL numread                // number of records read
  25. LOCAL bytesread              // number of bytes read (should = 128)
  26. LOCAL optionstr              // options as a binary string
  27.  
  28.     UserFile := if( UserFile == NIL, 'USERS', UserFile )
  29.  
  30.     handle := fopen( UserFile, FO_READ )
  31.     if (handle == F_ERROR)
  32.         errorlevel(2)
  33.         quit
  34.     endif
  35.  
  36.     length := fseek(handle, 0, FS_END)
  37.     recs   := length/128
  38.     fseek( handle, 0 , FS_SET )
  39.  
  40.     if ! file('convert.dbf')
  41.         MakeDBF()
  42.     endif
  43.  
  44.     USE CONVERT NEW
  45.     ZAP
  46.  
  47.     UserBuffer := space(128)
  48.     numread    := 0
  49.  
  50.     do while ( bytesread := FREAD(handle, @UserBuffer, 128) ) == 128
  51.  
  52.         numread++
  53.         //setpos(24, 0)
  54.         //dispout( trans(numread,'99999')+':'+trans(recs,'99999') )
  55.  
  56.         FillRecord( User_, UserBuffer )
  57.  
  58.         if substr( User_[ U_NAME ], 1, 7) <> 'NEWUSER' .AND. ;
  59.            asc(left( User_[ U_NAME ], 1)) <> 0         .AND. ;
  60.            len(trim(substr( User_[ U_NAME ], 1, 31))) > 0
  61.  
  62.             dbappend()
  63.             n := at(' ', User_[ U_NAME ])
  64.             replace CONVERT->Firstname  with left( User_[ U_NAME ], n - 1), ;
  65.                     CONVERT->Lastname   with substr( User_[ U_NAME ], n + 1), ;
  66.                     CONVERT->Password   with User_[ U_PASSWORD ], ;
  67.                     CONVERT->Seclevel   with User_[ U_SECURITY ], ;
  68.                     CONVERT->CityState  with User_[ U_CITYSTATE ], ;
  69.                     CONVERT->DateTime   with User_[ U_DATETIME ], ;
  70.                     CONVERT->Ul         with User_[ U_ULS ], ;
  71.                     CONVERT->Dl         with User_[ U_DLS ], ;
  72.                     CONVERT->Elapsetime with User_[ U_ELAPTIME ], ;
  73.                     CONVERT->ReadMsg    with User_[ U_LASTMSG ], ;
  74.                     CONVERT->TimesOn    with User_[ U_TIMESON ], ;
  75.                     CONVERT->RightMarg  with User_[ U_RMARGIN ], ;
  76.                     CONVERT->PageLength with User_[ U_PAGELEN ], ;
  77.                     CONVERT->Graphics   with User_[ U_GRAPHICS ]
  78.  
  79.             replace CONVERT->Protocol   with ;
  80.                       if(User_[ U_PROTOCOL ]==' ', 'N', User_[ U_PROTOCOL ]), ;
  81.                     CONVERT->EchoedBy   with ;
  82.                       if(User_[ U_ECHOER ]==' ','R', User_[ U_ECHOER ]), ;
  83.                     CONVERT->LastList   with ;
  84.                       LastListed( User_[ U_LASTDIR ] ), ;
  85.                     CONVERT->FDL_Today  with Cvs( User_[ U_DLTODAY ] ), ;
  86.                     CONVERT->BDL_Today  with Cvs( User_[ U_BYTESDL ] ), ;
  87.                     CONVERT->BDL_Ever   with Cvs( User_[ U_DLBYTES ] ), ;
  88.                     CONVERT->BUL_Ever   with Cvs( User_[ U_ULBYTES ] )
  89.  
  90.             optionstr := Dec2Bin( User_[ U_OPTIONS ], 16 )
  91.             replace CONVERT->Promptbell with BitSet(optionstr,1), ;
  92.                     CONVERT->Expert     with BitSet(optionstr,2), ;
  93.                     CONVERT->NullsOn    with BitSet(optionstr,3), ;
  94.                     CONVERT->Uppercase  with BitSet(optionstr,4), ;
  95.                     CONVERT->Linefeeds  with BitSet(optionstr,5), ;
  96.                     CONVERT->Checkbull  with BitSet(optionstr,6), ;
  97.                     CONVERT->Skipfiles  with BitSet(optionstr,7), ;
  98.                     CONVERT->Autodl     with BitSet(optionstr,8), ;
  99.                     CONVERT->Answerques with BitSet(optionstr,9), ;
  100.                     CONVERT->Mailwait   with BitSet(optionstr,10), ;
  101.                     CONVERT->Highliting with BitSet(optionstr,11), ;
  102.                     CONVERT->Turbokey   with BitSet(optionstr,12)
  103.  
  104.             // TwoByte() makes the IDL calls.
  105.             REPLACE CONVERT->Sub_Date   with TwoByte( User_[ U_SUBDATE ] )
  106.  
  107.         endif
  108.  
  109.     enddo
  110.  
  111.     fclose( handle )
  112.     USE
  113.  
  114. RETURN NIL
  115.  
  116.  
  117. /* ==========================================================================
  118.     PadLc()
  119.     SYNTAX: PadLc( string, length, Padchar )
  120.     PURPOSE: Pad string to left with PadChar to total of (Length) chars
  121. ---------------------------------------------------------------------------*/
  122. FUNCTION PadLc(String, Length, PadChar)
  123. RETURN right(replicate(PadChar,Length)+String,Length)
  124.  
  125.  
  126. /* ==========================================================================
  127.     Num2Strg()
  128.     SYNTAX: Num2Strg(Number, StringLen)
  129.     PURPOSE: Convert number to string, length StringLen, padded to left
  130.              with zeros.
  131. ---------------------------------------------------------------------------*/
  132. FUNCTION Num2Strg(Number, StrgLen)
  133. RETURN PadLc(ltrim(rtrim(str(Number,StrgLen))),StrgLen,"0")
  134.  
  135.  
  136. /* ==========================================================================
  137.     FillRecord()
  138.     SYNTAX: FillRecord( UserArray[], UserBuffer )
  139.     PURPOSE: Fills array with data from current buffer via USER.CH constants.
  140. ---------------------------------------------------------------------------*/
  141. STATIC FUNCTION FillRecord( User_, UserBuffer )
  142.  
  143.     User_[ U_NAME ]     := SUBSTR(UserBuffer,1,31)
  144.     User_[ U_PASSWORD ] := SUBSTR(UserBuffer,32,15)
  145.     User_[ U_SECURITY ] := BIN2I(SUBSTR(UserBuffer,47,2))
  146.     User_[ U_TIMESON ]  := BIN2I(SUBSTR(UserBuffer,49,2))
  147.     User_[ U_LASTMSG ]  := BIN2I(SUBSTR(UserBuffer,51,2))
  148.     User_[ U_PROTOCOL ] := SUBSTR(UserBuffer,53,1)
  149.     User_[ U_GRAPHICS ] := ASC(SUBSTR(UserBuffer,54,1))
  150.     User_[ U_RMARGIN ]  := BIN2I(SUBSTR(UserBuffer,55,2))
  151.     User_[ U_OPTIONS ]  := BIN2I(SUBSTR(UserBuffer,57,2))
  152.     User_[ U_SUBDATE ]  := SUBSTR(UserBuffer,59,2)
  153.     User_[ U_PAGELEN ]  := ASC(SUBSTR(UserBuffer,61,1))
  154.     User_[ U_ECHOER ]   := SUBSTR(UserBuffer,62,1)
  155.     User_[ U_CITYSTATE ]:= SUBSTR(UserBuffer,63,24)
  156.     User_[ U_MACHINE ]  := SUBSTR(UserBuffer,87,3)
  157.     User_[ U_DLTODAY ]  := SUBSTR(UserBuffer,90,4)
  158.     User_[ U_BYTESDL ]  := SUBSTR(UserBuffer,94,4)
  159.     User_[ U_DLBYTES ]  := SUBSTR(UserBuffer,98,4)
  160.     User_[ U_ULBYTES ]  := SUBSTR(UserBuffer,102,4)
  161.     User_[ U_DATETIME ] := SUBSTR(UserBuffer,106,14)
  162.     User_[ U_LASTDIR ]  := SUBSTR(UserBuffer,120,3)
  163.     User_[ U_DLS ]      := BIN2I(SUBSTR(UserBuffer,123,2))
  164.     User_[ U_ULS ]      := BIN2I(SUBSTR(UserBuffer,125,2))
  165.     User_[ U_ELAPTIME ] := BIN2I(SUBSTR(UserBuffer,127,2))
  166.  
  167. RETURN NIL
  168.  
  169.  
  170. /* ==========================================================================
  171.     MakeDBF()
  172.     SYNTAX: MakeDBF()
  173.     PURPOSE: Creates the Convert.dbf file.
  174. ---------------------------------------------------------------------------*/
  175. STATIC FUNCTION MAKEDBF()
  176. LOCAL dbf_
  177.  
  178.     dbf_ := {}
  179.     aadd( dbf_, { "FIRSTNAME", "C", 15, 0 } )
  180.     aadd( dbf_, { "LASTNAME",  "C", 20, 0 } )
  181.     aadd( dbf_, { "PASSWORD",  "C", 15, 0 } )
  182.     aadd( dbf_, { "SECLEVEL",  "N",  5, 0 } )
  183.     aadd( dbf_, { "CITYSTATE", "C", 24, 0 } )
  184.     aadd( dbf_, { "DATETIME",  "C", 14, 0 } )
  185.     aadd( dbf_, { "LASTLIST",  "D",  8, 0 } )
  186.     aadd( dbf_, { "UL",        "N",  5, 0 } )
  187.     aadd( dbf_, { "DL",        "N",  5, 0 } )
  188.     aadd( dbf_, { "ELAPSETIME","N",  5, 0 } )
  189.     aadd( dbf_, { "READMSG",   "N",  5, 0 } )
  190.     aadd( dbf_, { "TIMESON",   "N",  5, 0 } )
  191.     aadd( dbf_, { "FDL_TODAY", "N",  8, 0 } )
  192.     aadd( dbf_, { "BDL_TODAY", "N",  8, 0 } )
  193.     aadd( dbf_, { "BDL_EVER",  "N",  8, 0 } )
  194.     aadd( dbf_, { "BUL_EVER",  "N",  8, 0 } )
  195.     aadd( dbf_, { "ECHOEDBY",  "C",  1, 0 } )
  196.     aadd( dbf_, { "PROMPTBELL","L",  1, 0 } )
  197.     aadd( dbf_, { "EXPERT",    "L",  1, 0 } )
  198.     aadd( dbf_, { "NULLSON",   "L",  1, 0 } )
  199.     aadd( dbf_, { "UPPERCASE", "L",  1, 0 } )
  200.     aadd( dbf_, { "LINEFEEDS", "L",  1, 0 } )
  201.     aadd( dbf_, { "CHECKBULL", "L",  1, 0 } )
  202.     aadd( dbf_, { "SKIPFILES", "L",  1, 0 } )
  203.     aadd( dbf_, { "AUTODL",    "L",  1, 0 } )
  204.     aadd( dbf_, { "ANSWERQUES","L",  1, 0 } )
  205.     aadd( dbf_, { "MAILWAIT",  "L",  1, 0 } )
  206.     aadd( dbf_, { "HIGHLITING","L",  1, 0 } )
  207.     aadd( dbf_, { "TURBOKEY",  "L",  1, 0 } )
  208.     aadd( dbf_, { "RIGHTMARG", "N",  5, 0 } )
  209.     aadd( dbf_, { "PAGELENGTH","N",  2, 0 } )
  210.     aadd( dbf_, { "SUB_DATE",  "D",  8, 0 } )
  211.     aadd( dbf_, { "GRAPHICS",  "N",  2, 0 } )
  212.     aadd( dbf_, { "PROTOCOL",  "C",  1, 0 } )
  213.     dbcreate( "CONVERT.DBF", dbf_ )
  214.  
  215. RETURN NIL
  216.  
  217.  
  218. /* ==========================================================================
  219.     Cvs()
  220.     SYNTAX: Cvs( Four_Bytes )
  221.     PURPOSE: Returns the actual number from the BASIC MBF MKS() four bytes.
  222. ---------------------------------------------------------------------------*/
  223. STATIC FUNCTION CVS(_mbf)
  224. local retval := 0, x1 := "", k, sign, exponent, fraction
  225.  
  226.     if asc(substr(_mbf,4,1)) != 0
  227.         for k := len(_mbf) to 1 step -1
  228.             x1 += Dec2bin(asc(substr(_mbf,k,1)),8)
  229.         next k
  230.         sign     := (substr(x1,9,1) == "1")
  231.         exponent := Bin2dec(substr(x1,1,8)) - 128
  232.         fraction := Bin2dec("1"+substr(x1,10)) / (2**24 )
  233.         retval   := if(sign,-1,1) * (fraction * (2**exponent))
  234.     endif
  235.  
  236. RETURN retval
  237.  
  238.  
  239. /* ==========================================================================
  240.     Bin2Dec()
  241.     SYNTAX: Bin2Dec( string )
  242.     PURPOSE: Returns numeric based on binary string, ie. "00010001"
  243. ---------------------------------------------------------------------------*/
  244. STATIC FUNCTION BIN2DEC(_string)
  245. local l, t, n := 0
  246.  
  247.     l := len(_string)
  248.     for t := 1 to l
  249.         n += if(substr(_string,t,1)=="1",2^(l-t),0)
  250.     next t
  251.  
  252. RETURN (n)
  253.  
  254.  
  255. /* ==========================================================================
  256.     Dec2Bin()
  257.     SYNTAX: Dec2Bin( number, n )
  258.     PURPOSE: Return a binary string "n" characters in length.
  259. ---------------------------------------------------------------------------*/
  260. STATIC FUNCTION DEC2BIN(_number, n)
  261. local tmp := _number, retval := "", remd, quot
  262.  
  263.     do while .t.
  264.         quot  := int(tmp/2)
  265.         remd  := abs(tmp) - 2*abs(quot)
  266.         retval:= substr("01",remd+1,1)+retval
  267.         if quot==0
  268.             exit
  269.         endif
  270.         tmp   := quot
  271.     enddo
  272.  
  273.     * Pad to n "digits"
  274.     do while len(retval) < n
  275.         retval := "0" + retval
  276.     enddo
  277.  
  278. RETURN retval
  279.  
  280.  
  281. // ==========================[ BitSet ]======================================
  282. STATIC FUNCTION BITSET( string, n )
  283. LOCAL l := len( string )
  284. RETURN (substr( string, (l+1)-n, 1) == "1")
  285.  
  286.  
  287. /* ==========================================================================
  288.     LastListed()
  289.     SYNTAX: LastListed( Three_Bytes )
  290.     PURPOSE: Returns dBASE date from RBBS-PC 3 byte Last Listed Format
  291. ---------------------------------------------------------------------------*/
  292. STATIC FUNCTION LASTLISTED( LastDir )
  293. LOCAL Ye, Mo, Da, TempStr
  294.  
  295.     Ye := Num2Strg( asc(substr(LastDir,1,1)),2)
  296.     Mo := Num2Strg( asc(substr(LastDir,2,1)),2)
  297.     Da := Num2Strg( asc(substr(LastDir,3,1)),2)
  298.     Tempstr := ctod(Mo + "/" + Da + "/" + Ye)
  299.  
  300. RETURN if(empty(TempStr), ctod('01/01/80'), TempStr)
  301.  
  302.  
  303. /* ==========================================================================
  304.     TwoByte()
  305.     SYNTAX: TwoByte( RBBS_twobytes )
  306.     PURPOSE: Return a dBASE date from RBBS-PC 2 byte "crunched" date.
  307. ---------------------------------------------------------------------------*/
  308. STATIC FUNCTION TWOBYTE( two_bytes )
  309. LOCAL b1 := substr( two_bytes, 1, 1 ), ;
  310.       b2 := substr( two_bytes, 2, 1 )
  311. LOCAL nYear, nMonth, nDay
  312.  
  313.     nYear  := BIT_AND(asc( b1 ), BIT_NOT( 1)) / 2 + 1980
  314.     nMonth := BIT_OR( asc( b2 ) / 32, (BIT_AND( asc( b1 ), 1 ) * 8) )
  315.     nDay   := BIT_AND( asc( b2 ), BIT_NOT( 224 ) )
  316.  
  317. RETURN ctod( trans(nMonth, '99') + '/' + trans( nDay, '99' ) + '/' + ;
  318.              trans(nYear, '9999') )
  319.